home *** CD-ROM | disk | FTP | other *** search
/ Freaks Macintosh Archive / Freaks Macintosh Archive.bin / Freaks Macintosh Archives / Phreaking⁄Wardialers / Tone Generators / AutoTONE / AutoTONE 3.16 (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-10-07  |  8KB  |  354 lines
  1. REM AutoTONE Phone Tone Generator Version 3.16
  2. REM by The (403) Phoney
  3. REM Original Concept: /TUC403/
  4. REM Edmonton, Alberta, Canada
  5.  
  6.         CLEAR,20000,5000
  7.         DIM a%(256):DIM t$(58)
  8.         GOSUB intro1
  9.         FOR x=1 TO 800:NEXT
  10.         GOSUB intro2
  11.         LOCATE 9,17:PRINT "AutoTONE - by The (403) Phoney"
  12.         FOR x=1 TO 500:NEXT
  13.         GOSUB intro2
  14.         GOSUB intro3
  15.         FOR x=1 TO 3000:NEXT
  16.         GOSUB setup
  17.         GOSUB info
  18.         GOSUB contents
  19.         GOSUB controls
  20. loop:
  21.         WHILE ok
  22.             event=0
  23.             WINDOW OUTPUT 1
  24.             WHILE event=0: event=<0x43,0x07>(0):WEND
  25.             IF event=1 THEN GOSUB parm
  26.             IF event=5 THEN GOSUB refresh
  27.         WEND
  28. quit:
  29.         CLEAR
  30.         WINDOW CLOSE 3
  31.         WINDOW CLOSE 2
  32.         WINDOW CLOSE 1
  33.         CLS
  34.         SYSTEM
  35.       END
  36.         
  37. intro1:
  38.         SOUND WAIT:POKEW 1,SIN:POKEW 2,SIN:POKEW 3,SIN:POKEW 0,SIN
  39.         n=2:d=25:d1=350:d2=440:GOSUB tone
  40.     RETURN
  41.     
  42. intro2:        
  43.         d=4:FOR x=1 TO 2
  44.         d1=697:d2=1477:GOSUB tone
  45.         d1=770:d2=1477:GOSUB tone
  46.         d1=697:d2=1477:GOSUB tone
  47.         d1=697:d2=1209:GOSUB tone
  48.         NEXT
  49.     RETURN
  50.     
  51. intro3:
  52.         d=30:m=5
  53.         d1=440:d2=480:GOSUB tone2
  54.     RETURN
  55.  
  56. setup:
  57.         CLS
  58.         wf=1:GOSUB waveform
  59.         WINDOW 1,"Keypad",(0,190)-(511,341),3
  60.         CALL <0x1a,0x07>(3):CALL <0x1a,0x01>(12):CALL <0x1a,0x00>(1)
  61.         WINDOW 2,"Output ",(0,45)-(511,189),3
  62.         CALL <0x12,0x07>(3):CALL <0x12,0x01>(12)
  63.         WINDOW 3 ,"About AutoTONE",(0,20)-(511,44),3
  64.         CALL <0x11,0x07>(3):CALL <0x11,0x01>(9)
  65.         wrap=61:ll=0:box=1:ok=1:tp=0:mn=11:tb=58:v=255:noise=3300
  66.     RETURN
  67.         
  68. info:
  69.         WINDOW OUTPUT 3
  70.         CLS
  71.         CALL <0x53,0x07>(0):PRINT SPC(15);"AutoTONE Phone Tone Generator Version 3   by The (403) Phoney "
  72.     RETURN
  73.  
  74. controls:
  75.         t=1
  76.         WINDOW  1
  77.         FOR y=1 TO 2
  78.             FOR x=1 TO 3
  79.                 <0x40,0x07> (y-1)*3+x,1,t$(t),(60*x-50,40*y-10)-(60*x,40 *y+20),1
  80.                 t=t+1
  81.             NEXT
  82.         NEXT
  83.         <0x40,0x07> 7,1,t$(t),(10,110)-(60,140),1
  84.         t=t+1
  85.         <0x40,0x07> 8,1,t$(t),(70,110)-(180,140),1
  86.         t=t+1
  87.         LINE (195,0)-(195,151)
  88.         FOR y=1 TO 3
  89.             <0x40,0x07> 8+y,1,t$(t),(210,40*y-10)-(280,40*y+20),1
  90.             t=t+1
  91.         NEXT
  92.         LINE (300,0)-(300,151)
  93.         np=3:p=0:GOSUB arrow
  94.         GOSUB dobox
  95.         LOCATE 1,4:PRINT "TONE BOX MENU"
  96.         LOCATE 1,24:PRINT"WAVEFORM"
  97.     RETURN
  98.  
  99. dobox:
  100.         ON box GOSUB DTMF,MF,SILVER,BLUE,RED,GREEN
  101.         max=max+mn
  102.         CALL <0x09,0x07>(1)
  103.         LOCATE 1,40:PRINT"                         ":LOCATE 1,pp:PRINT bn$
  104.         np=2:p=tp:GOSUB arrow
  105.     RETURN
  106.  
  107. DTMF:
  108.         t=12
  109.         FOR y= 1 TO 4
  110.             FOR x= 1 TO 3
  111.                 <0x40,0x07> (y-1)*3+x+mn,1,t$(t),(30*x+310,30*y)-(30*x+330,30*y+20),1
  112.                 t=t+1
  113.             NEXT
  114.         NEXT
  115.         max=12:pp=41:bn$="DTMF"
  116.     RETURN
  117.  
  118. MF:
  119.         t=24
  120.         FOR y=1 TO 3
  121.             FOR x=1 TO 3
  122.                 <0x40,0x07> (y-1)*3+x+mn,1,t$(t),(30*x+310,30*y)-(30*x+330,30*y+20),1
  123.                 t=t+1
  124.             NEXT
  125.         NEXT
  126.         <0x40,0x07> 10+mn,1,t$(t),(370,120)-(390,140),1
  127.         t=t+1
  128.         max=10:pp=42:bn$="MF"
  129.     RETURN
  130.  
  131. SILVER:
  132.         t=34
  133.         FOR y=1 TO 4
  134.             <0x40,0x07> y+mn,1,t$(t),(375,30*y)-(395,30*y+20),1
  135.             t=t+1
  136.         NEXT
  137.         max=4:pp=41:bn$="SILVER"
  138.     RETURN
  139.  
  140.  BLUE:
  141.         t=38
  142.         FOR y=1 TO 4
  143.             FOR x=1 TO 2
  144.                 <0x40,0x07> (y-1)*2+x+mn,1,t$(t),(60*x+260,30*y)-(60*x+310,30*y+20),1
  145.                 t=t+1
  146.             NEXT
  147.         NEXT
  148.         FOR y=1 TO 2
  149.             <0x40,0x07> y+8+mn,1,t$(t),(440,40*y-10)-(460,40*y+20),1
  150.             t=t+1
  151.         NEXT
  152.         max=10:pp=41:bn$="BLUE       TYPE"
  153.     RETURN
  154.  
  155. RED:
  156.         t=48
  157.         FOR y=1 TO 4
  158.             <0x40,0x07> y+mn,1,t$(t),(360,30*y)-(430,30*y+20),1
  159.             t=t+1
  160.         NEXT
  161.         FOR y=1 TO 2
  162.             <0x40,0x07> y+4+mn,1,t$(t),(440,40*y-10)-(460,40*y+20),1
  163.             t=t+1
  164.         NEXT
  165.         max=6:pp=43:bn$="RED      TYPE"
  166.     RETURN
  167.  
  168. GREEN:
  169.         t=54
  170.         FOR y=1 TO 3
  171.             <0x40,0x07> y+mn,1,t$(t),(375,30*y)-(415,30*y+20),1
  172.             t=t+1
  173.         NEXT
  174.         FOR y=1 TO 2
  175.             <0x40,0x07> y+3+mn,1,t$(t),(440,40*y-10)-(460,40*y+20),1
  176.             t=t+1
  177.         NEXT      
  178.  
  179.         max=5:pp=42:bn$="GREEN     TYPE"
  180.     RETURN
  181.  
  182. cleanup:
  183.         FOR bcl=mn+1 TO max:<0x40,0x07> CLOSE bcl:NEXT:RETURN
  184.  
  185. refresh:
  186.         IF <0x43,0x07>(5)<2 THEN GOSUB info: GOSUB controls
  187.     RETURN
  188.  
  189. sweep:
  190.         WINDOW OUTPUT 2
  191.         CLS
  192.         CALL <0x23,0x07>(0):PRINT "Output Window Cleared"
  193.         ll=0
  194.     RETURN
  195.     
  196. arrow:
  197.         CALL <0x09,0x07>(1)
  198.         yp=3:yo=3
  199.         IF np=3 THEN xp=32  :ELSE xp=52
  200.         FOR x=0 TO np-1:LOCATE x*yo+yp,xp:PRINT "   ":NEXT
  201.         IF box=4 OR box=5 OR box=6 OR np=3 THEN LOCATE p*yo+yp,xp:PRINT "<<"
  202.     RETURN
  203.  
  204. contents:
  205.         FOR x=1 TO tb:READ t$(x):NEXT:
  206.         DATA DTMF,MF,SILVER,BLUE,RED,GREEN,CLR,QUIT !,sine,sawtooth,square,1,2,3,4,5,6,7,8,9,*,0,#,1,2,3,4,5,6,7,8,9,0,A,B,C,D,2600,2750,3700,KP,ST,ST2P,ST3P,STP,0,1,nickel,dime,quarter33,quarter66,0,1,c/c,c/r,r/b,0,1
  207.     RETURN
  208.  
  209. parm:
  210.         d=3:n=2:l=1:m=1:f=0:dwd=1.1:dw=2600:dbd=1.7:tps=0
  211.         p=<0x43,0x07>(1)
  212.         IF p<7 THEN box=p:GOSUB cleanup:GOSUB dobox
  213.         IF p=7 THEN GOSUB sweep
  214.         IF p=8 THEN ok=0
  215.         IF p>8 AND p<12 THEN wf=p-8:GOSUB waveform
  216.         IF p>11 THEN b=p-11:ON box GOSUB dwbt,mwbt,sbt,bbt,rbt,gbt,oct:GOSUB out
  217.     RETURN
  218.  
  219. dwbt:
  220.         IF b=1 THEN a$="1":d1=697:d2=1209
  221.         IF b=2 THEN a$="2":d1=697:d2=1336
  222.         IF b=3 THEN a$="3":d1=697:d2=1477
  223.         IF b=4 THEN a$="4":d1=770:d2=1209
  224.         IF b=5 THEN a$="5":d1=770:d2=1336
  225.         IF b=6 THEN a$="6":d1=770:d2=1477
  226.         IF b=7 THEN a$="7":d1=852:d2=1209
  227.         IF b=8 THEN a$="8":d1=852:d2=1336
  228.         IF b=9 THEN a$="9":d1=852:d2=1477
  229.         IF b=10 THEN a$="*":d1=941:d2=1209
  230.         IF b=11 THEN a$="0":d1=941:d2=1336
  231.         IF b=12 THEN a$="#":d1=941:d2=1477
  232.     RETURN
  233.  
  234. mwbt:
  235.         f=4
  236.         IF b=1 THEN a$="1":d1=700:d2=900
  237.         IF b=2 THEN a$="2":d1=700:d2=1100
  238.         IF b=3 THEN a$="3":d1=900:d2=1100
  239.         IF b=4 THEN a$="4":d1=700:d2=1300
  240.         IF b=5 THEN a$="5":d1=900:d2=1300
  241.         IF b=6 THEN a$="6":d1=1100:d2=1300
  242.         IF b=7 THEN a$="7":d1=700: d2=1500
  243.         IF b=8 THEN a$="8":d1=900:d2=1500
  244.         IF b=9 THEN a$="9":d1=1100:d2=1500
  245.         IF b=10 THEN a$="0":d1=1300:d2=1500
  246.     RETURN
  247.         
  248. sbt:
  249.         IF b=1THEN a$="-Flash (A)-": d1=697: d2=1633:l=11
  250.         IF b=2 THEN a$="-Immediate (B)-": d1=770: d2=1633:l=15
  251.         IF b=3 THEN a$="-Priority (C)-":d1=852:d2=1633:l=14
  252.         IF b=4 THEN a$="-Routine (D)-":d1=941:d2=1633:l=13
  253.     RETURN
  254.  
  255. bbt:
  256.         np=2:p=tp
  257.         IF tp THEN d2=noise :ELSE d2=0
  258.         IF b=1 THEN a$="-2600 Hz-":d1=2600:d=10:l=9:f=4
  259.         IF b=2 THEN a$="-2750 Hz-":d1=2750:d=10:l=9:f=4
  260.         IF b=3 THEN a$="-3700 Hz-":d1=3700:d=10:l=9:f=4
  261.         IF b=4 THEN a$="-KP (KP1)-":d1=1100:d2=1700:d=5:l=10
  262.         IF b=5 THEN a$="-ST (ST)-":d1=1500:d2=1700:l=9
  263.         IF b=6 THEN a$="-ST3P (Code 11)-":d1=700:d2=1700:l=16
  264.         IF b=7 THEN a$="-STP (Code 12)-":d1=900:d2=1700:l=15
  265.         IF b=8 THEN a$="-ST2P (KP2)-":d1=1300:d2=1700:l=12
  266.         IF tp<1 THEN f=0
  267.         IF b=9 THEN tp=0:p=tp:GOSUB arrow:tps=1
  268.         IF b=10 THEN tp=1:p=tp:GOSUB arrow:tps=1
  269.     RETURN
  270.         
  271. rbt:
  272.         d1=1700:d2=2200:np=2:p=tp
  273.         IF b=1 THEN a$="-nickel-":d=1.2:m=1:l=8
  274.         IF b=2 THEN a$="-dime-":d=1.2:m=2:l=8
  275.         IF b=3 THEN a$="-quarter(33)-":d=0.6:m=5:l=13
  276.         IF b=4 THEN a$="-quarter(66)-":d=1.2:m=5:l=13
  277.         IF b=5 THEN tp=0:p=tp:GOSUB arrow:tps=1
  278.         IF b=6 THEN tp=1:p=tp:GOSUB arrow:tps=1
  279.         IF tp THEN d2=0:f=4
  280.         IF tp AND b>2 THEN d1=800:m=1
  281.     RETURN
  282.         
  283. gbt:
  284.         d=15:dwd=1.638:dbd=1.092:dw1=2600:dw2=0:np=2:p=tp
  285.         IF tp THEN dw1=900:dw2=1500:f=4
  286.         IF b=1 THEN a$="-coin collect-":d1=700:d2=1100:l=14
  287.         IF b=2 THEN a$="-coin return-":d1=1100:d2=1700:l=13
  288.         IF b=3 THEN a$="-ringback-":d1=700:d2=1700:l=10
  289.         IF b=4 THEN tp=0:p=tp:GOSUB arrow:tps=1
  290.         IF b=5 THEN tp=1:p=tp:GOSUB arrow:tps=1
  291.     RETURN
  292.         
  293. waveform:
  294.         ON wf GOSUB one,two,three
  295.         np=3:p=wf-1:GOSUB arrow
  296.     RETURN
  297.         
  298. one:
  299.         SOUND WAIT:POKEW 1,SIN:POKEW 2,SIN:POKEW 3,SIN:POKEW 0,SIN
  300.     RETURN
  301.  
  302. two:
  303.         FOR wfb=0 TO 255:a%(wfb)=-128+wfb:NEXT
  304.         SOUND WAIT:POKEW 1,a%:POKEW 2,a%:POKEW 3,a%:POKEW 0,a%
  305.     RETURN
  306.  
  307. three:
  308.         FOR wfb=0 TO 255:IF wfb<127 THEN a%(wfb)=-128 :ELSE a%(wfb)=127
  309.         NEXT:SOUND WAIT:POKEW 1,a%:POKEW 2,a%:POKEW 3,a%:POKEW 0,a%
  310.     RETURN
  311.  
  312. out:
  313.         IF  tps THEN RETURN
  314.         SOUND WAIT
  315.         WINDOW OUTPUT 2
  316.         ll=ll+l
  317.         CALL <0x0b,0x07>(f)
  318.         IF ll>wrap THEN ll=0:PRINT CHR$(13)
  319.         PRINT a$;
  320.         ON box GOSUB tone,tone,tone,tone,tone2,tone3
  321.     RETURN
  322.  
  323. tone:
  324.         SOUND d1,d,v,1
  325.         IF n>1 THEN SOUND d2,d,v,2
  326.         IF n>2 THEN SOUND d3,d,v,3
  327.         IF n>3 THEN SOUND d4,d,v,0
  328.         SOUND RESUME
  329.     RETURN
  330.  
  331. tone2:
  332.         FOR rep=1 TO m
  333.           SOUND d1,d,v,1:SOUND d2,d,v,2
  334.           SOUND 0,d,0,1:SOUND 0,d,0,2
  335.         NEXT
  336.         SOUND RESUME
  337.     RETURN
  338.  
  339. tone3:
  340.         SOUND dw1,dwd,v,1:SOUND dw2,dwd,(v*tp),2
  341.         SOUND 0,dbd,0,1:SOUND 0,dbd,0,2
  342.         SOUND d1,d,v,1:SOUND d2,d,v,2
  343.         SOUND RESUME
  344.         RETURN
  345.         
  346.  
  347.          
  348.          
  349.          
  350.          
  351.          
  352.         
  353.  
  354.